home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / sbprolog / amiga / builtin2.zoo / file.c < prev    next >
C/C++ Source or Header  |  1988-08-15  |  10KB  |  418 lines
  1. /************************************************************************
  2. *                                    *
  3. * The SB-Prolog System                            *
  4. * Copyright SUNY at Stony Brook, 1986; University of Arizona, 1987    *
  5. *                                    *
  6. ************************************************************************/
  7.  
  8. /*-----------------------------------------------------------------
  9. SB-Prolog is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY.  No author or distributor
  11. accepts responsibility to anyone for the consequences of using it
  12. or for whether it serves any particular purpose or works at all,
  13. unless he says so in writing.  Refer to the SB-Prolog General Public
  14. License for full details.
  15.  
  16. Everyone is granted permission to copy, modify and redistribute
  17. SB-Prolog, but only under the conditions described in the
  18. SB-Prolog General Public License.   A copy of this license is
  19. supposed to have been given to you along with SB-Prolog so you
  20. can know your rights and responsibilities.  It should be in a
  21. file named COPYING.  Among other things, the copyright notice
  22. and this notice must be preserved on all copies. 
  23. ------------------------------------------------------------------ */
  24.  
  25.  
  26. /* file.c */
  27.  
  28. #include "builtin.h"
  29. #ifndef AMIGA
  30. #include <netdb.h>
  31. #include <stdio.h>
  32. #endif
  33.  
  34. #define PMODE 0644
  35.  
  36. extern double floatval();
  37.  
  38. static int n, a, i;
  39. static int fileerrors = 0;    /* abort, or not on file errors */
  40. static struct psc_rec *user_psc, *stderr_psc, *ptr;
  41. static FILE *tempfile;
  42. static char s[256];
  43.  
  44. static word user_word, con_word, stderr_word;
  45.  
  46. struct ftab_ent {
  47.     int inout;        /* 1 if input, 0 if output */
  48.     word p_ptr;        /* tagged ptr to psc_ptr of constant */
  49.     FILE *fdes;        /* file descriptor for this constant */
  50.     };
  51.  
  52.     /* table of open files; 0 is always stdin,  1 is always stdout, 
  53.        2 is always stderr */
  54. static struct ftab_ent file_table[20];
  55. static int file_tab_end = 0; /* last used entry in file_table */
  56.  
  57.     /* index of current input (output) stream in file_table */
  58. static int in_file_i, out_file_i;
  59. extern FILE *curr_in, *curr_out;
  60.  
  61. static struct hostent *hp;
  62.  
  63.  
  64. int get_file_index(cword, io)
  65. word cword;
  66. int io;
  67. {
  68.     for (i=0; i<=file_tab_end; i++) {
  69.     if (file_table[i].p_ptr == cword)
  70.         if (io == file_table[i].inout || io >1) return(i);
  71.     }
  72.     return(-1);
  73. }
  74.  
  75. b_FILEERRORS()
  76. {
  77.         fileerrors = 1;
  78. }
  79.  
  80. b_NOFILEERRORS()
  81. {
  82.         fileerrors = 0;
  83. }
  84.  
  85. b_PUT() /* (N) */
  86. { 
  87.     register word op; 
  88.     register pw top;
  89.  
  90.     op = gregc(1); deref(op);
  91.     if (!isinteger(op)) {Fail0;}
  92.     else putc(intval(op), curr_out);
  93.     /* fflush(file_table[out_file_i].fdes); */
  94. }
  95.  
  96. b_GET0()  /* (N) */
  97. {
  98.     register word op;
  99.     register pw top;
  100.  
  101.     n = getc(curr_in);
  102.     if (n == EOF) clearerr(curr_in);
  103.     op = gregc(1); deref(op);
  104.     if (isnonvar(op)) {if (!unify(op, makeint(n))) {Fail0;}}
  105.     else {follow(op) = makeint(n); pushtrail(op);}
  106. }
  107.  
  108. b_GET()  /* (N) */
  109. {
  110.     register word op;
  111.     register pw top;
  112.  
  113.     do n = getc(curr_in);
  114.      while (n != EOF && n < 16 && n >= 112);
  115.     if (n == EOF) {
  116.         clearerr(curr_in);
  117.         Fail0; return;
  118.         }
  119.     op = gregc(1); deref(op);
  120.     if (isnonvar(op)) {if (!unify(op, makeint(n))) {Fail0;}}
  121.     else {follow(op) = makeint(n); pushtrail(op);}
  122. }
  123.  
  124. b_SKIP()
  125. {  /* ( N) */
  126.     register word op;
  127.     register pw top;
  128.  
  129.     op = gregc(1); deref(op);
  130.     if (!isinteger(op)) {Fail0; return;}
  131.     a = intval(op);
  132.     if (a < 16 || a >= 112) {Fail0;}
  133.     else {
  134.         do n = getc(curr_in);
  135.         while (n != EOF && n != a);
  136.         if (n = EOF) {
  137.         if (fileerrors) quit("end of file encountered.\n");
  138.         else {Fail0;}
  139.         }
  140.     }
  141. }
  142.  
  143. b_TAB()
  144. { /* (N) */
  145.     register word op;
  146.     register pw top;
  147.  
  148.     op = gregc(1); deref(op);
  149.     if (!isinteger(op)) {Fail0; return;}
  150.     a = intval(op);
  151.     if (a < 0) {Fail0; return;}
  152.     for ( ; a>0; a--) putc(' ', curr_out);
  153.     /* fflush(file_table[out_file_i].fdes); */
  154. }
  155.  
  156. b_NL()
  157. {    /* () */
  158.  
  159.         putc('\n', curr_out);
  160.         fflush(curr_out);
  161. }
  162.  
  163. b_WRITENAME()
  164. {     /* (X) */
  165.     register word op;
  166.     register pw top;
  167.  
  168.     op = gregc(1); 
  169.     wnd: switch ((int)(op&3)) {
  170.         case FREE:
  171.         nderef(op, wnd);
  172.         fprintf(curr_out, "_%d", untagged(op));
  173.         break;
  174.         case LIST:
  175.         fprintf(curr_out, ".");
  176.         break;
  177.         case CS:
  178.         ptr = get_str_psc(op);
  179.             if (get_etype(ptr) == T_BUFF) {
  180.            printf("Buffer_%x", get_name(ptr));
  181.             } 
  182.         else writepname(curr_out, get_name(ptr), get_length(ptr));
  183.         break;
  184.         case NUM:
  185.         if (isinteger(op))
  186.             fprintf(curr_out, "%d", intval(op));
  187.         else fprintf(curr_out, "%f", floatval(op));
  188.         break;
  189.     }
  190.     /* fflush(file_table[out_file_i].fdes); */
  191. }
  192.  
  193. b_WRITEQNAME()
  194. {     /* (X) */
  195.     register word op;
  196.     register pw top;
  197.  
  198.     op = gregc(1); 
  199.     wnd: switch ((int)(op&3)) {
  200.         case FREE:
  201.         nderef(op, wnd);
  202.         fprintf(curr_out, "_%d", untagged(op));
  203.         break;
  204.         case LIST:
  205.         fprintf(curr_out, ".");
  206.         break;
  207.         case CS:
  208.         ptr = get_str_psc(op);
  209.             if (get_etype(ptr) == T_BUFF) {
  210.            printf("Buffer_%x", get_name(ptr));
  211.             } 
  212.         else writeqname(curr_out, get_name(ptr), get_length(ptr));
  213.         break;
  214.         case NUM:
  215.         if (isinteger(op))
  216.             fprintf(curr_out, "%d", intval(op));
  217.         else fprintf(curr_out, "%f", floatval(op));
  218.         break;
  219.     }
  220.     /* fflush(file_table[out_file_i].fdes); */
  221. }
  222.  
  223. b_RESET()  /* () */
  224. {
  225.     quit("RESET not implemented\n");
  226.     
  227. /*    fop = gregc(1);
  228.     get_file_psc();
  229.     if (p == user_psc) set_file_ptr(p, stdin);
  230.     else {
  231.         namestring(p, s);
  232.         set_file_ptr(p, fopen(s, "r"));
  233.         if (get_file_ptr(p)==0) {Fail0;}
  234.     } */
  235. }
  236.  
  237. b_REWRITE()
  238. {
  239.     quit("REWRITE not implemented\n");
  240. /*
  241.     fop = gregc(1);
  242.     get_file_psc();
  243.     if (p == user_psc) set_file_ptr(p, stdout);
  244.     else {
  245.         namestring(p, s);
  246.         set_file_ptr(p, fopen(s, "w"));
  247.         if (get_file_ptr(p)==0) {Fail0;}
  248.     } */
  249. }
  250.  
  251. b_CLOSE()
  252. {
  253.     register word fop;
  254.     register pw top;
  255.  
  256.     fop = gregc(1); deref(fop);
  257.     i = get_file_index(fop, 2);
  258.     if (i>1) {  /* not user */
  259.         fclose(file_table[i].fdes);
  260.         for ( ; i<file_tab_end; i++) {
  261.         file_table[i] = file_table[i+1];
  262.         }
  263.         file_tab_end--;
  264.     }
  265. }
  266.  
  267. b_SEE()  /* r1: file name */
  268. {
  269.     register word fop;
  270.     register pw top;
  271.     int temp_in_file_i;
  272.  
  273.     fop = gregc(1); deref(fop);
  274.     temp_in_file_i = get_file_index(fop, 1);
  275.     if (temp_in_file_i<0) {  /* not in table */
  276.         namestring(get_str_psc(fop), s);
  277.         tempfile = fopen(s, "r");
  278.         if (!tempfile) {Fail0; return;} /* leaving in_file_i unchanged */
  279.         in_file_i = ++file_tab_end;
  280.         file_table[in_file_i].inout = 1;
  281.         file_table[in_file_i].p_ptr = fop;
  282.         file_table[in_file_i].fdes = tempfile;
  283.     }
  284.     else in_file_i = temp_in_file_i; /* take it from table */
  285.     curr_in = file_table[in_file_i].fdes;
  286. }
  287.  
  288. b_TELL()  /* r1: file name */
  289.       /* r2: 0 -> open `w'-write; 1 -> open `a'-append */
  290. {
  291.     register word sop, fop;
  292.     register pw top;
  293.  
  294.     fop = gregc(1); deref(fop);
  295.     sop = gregc(2); deref(sop);
  296.     out_file_i = get_file_index(fop, 0);
  297.     if (out_file_i<0) {  /* not in table */
  298.         namestring(get_str_psc(fop), s);
  299.         if(intval(sop)) tempfile = fopen(s, "a");
  300.         else tempfile = fopen(s, "w");
  301.         if (!tempfile) {Fail0; return;}
  302.         out_file_i = ++file_tab_end;
  303.         file_table[out_file_i].inout = 0;
  304.         file_table[out_file_i].p_ptr = fop;
  305.         file_table[out_file_i].fdes = tempfile;
  306.     };
  307.     curr_out = file_table[out_file_i].fdes;
  308. }
  309.  
  310. b_SEEING()  /* r1: unified with the current input file name */
  311. {
  312.     if (!unify(gregc(1), file_table[in_file_i].p_ptr)) {Fail0;}
  313. }
  314.  
  315. b_TELLING()  /* r1: unified with the current out put file name */
  316. {
  317.     if (!unify(gregc(1), file_table[out_file_i].p_ptr)) {Fail0;}
  318. }
  319.  
  320. b_SEEN()
  321. {
  322.     if (in_file_i > 2) {
  323.     fclose(curr_in);
  324.     for ( ; in_file_i<file_tab_end; in_file_i++) {
  325.         file_table[in_file_i] = file_table[in_file_i+1];
  326.     }
  327.     file_tab_end--;
  328.     }
  329.     in_file_i = 0; /* reset to user */
  330.     curr_in = file_table[in_file_i].fdes;
  331. }
  332.  
  333. b_TOLD()
  334. {
  335.     if (out_file_i > 2) {
  336.     fclose(file_table[out_file_i].fdes);
  337.     for ( ; out_file_i<file_tab_end; out_file_i++) {
  338.         file_table[out_file_i] = file_table[out_file_i+1];
  339.     }
  340.     file_tab_end--;
  341.     }
  342.     out_file_i = 1; /* reset to user */
  343.     curr_out = file_table[out_file_i].fdes;
  344. }
  345.  
  346.  
  347. b_GETHOSTBYNAME() /*     r1 is a constant indicating the host name, 
  348.             r2 is a namebuffer (of length 16) returned */
  349. {
  350.     register word op1, op2;
  351.     register pw top;
  352.  
  353. #ifdef AMIGA
  354.     printf("Error, gethostbyname has not been ported in this version\n");
  355.     printf("Change file builtin/file.c to add this function\n");
  356.     Fail0;
  357. #else    
  358.     op1 = gregc(1); deref(op1);
  359.     op2 = gregc(2); deref(op2);
  360.     namestring(get_str_psc(op1), s);
  361.     hp = gethostbyname(s);
  362.     bcopy(hp->h_addr, get_name(get_str_psc(op2))+4, hp->h_length);
  363. #endif
  364. }
  365.     
  366.  
  367. file_init()
  368. {
  369.     word temp;
  370.     char perm = 1;
  371.     char arity = 0;
  372.  
  373.     temp = insert("user", 4, arity, &perm);
  374.     user_psc = (struct psc_rec *)(follow(temp));
  375.     user_word = temp | CS_TAG;
  376.  
  377.     temp = insert("stderr", 6, arity, &perm);
  378.     stderr_psc = (struct psc_rec *)(follow(temp));
  379.     stderr_word = temp | CS_TAG;
  380.  
  381.     file_table[0].inout = 1;
  382.     file_table[0].p_ptr = user_word;
  383.     file_table[0].fdes = stdin;
  384.     in_file_i = 0;
  385.     curr_in = stdin;
  386.  
  387.     file_table[1].inout = 0;
  388.     file_table[1].p_ptr = user_word;
  389.     file_table[1].fdes = stdout;
  390.     out_file_i = 1;
  391.     curr_out = stdout;
  392.  
  393.     file_table[2].inout = 0;
  394.     file_table[2].p_ptr = stderr_word;
  395.     file_table[2].fdes = stderr;
  396.  
  397.     file_tab_end = 2;
  398. }
  399.  
  400. b_WRITE4()
  401. {    /* register 1 contains a bit string that is written out in 4 bytes */
  402.  
  403.     register word op, wbyte;
  404.     register pw top;
  405.     int i;
  406.  
  407.     op = gregc(1); deref(op);
  408.     for (i = 1; i <= 4; i++)
  409.     {    wbyte = ((op & 0xff000000)>>24);
  410.     op = op << 8;
  411.     putc(wbyte, curr_out);
  412.     }
  413.     return;
  414. }
  415.  
  416.  
  417.  
  418.